home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / Help / Help Files / Constraints / BT-Solver next >
Text File  |  1994-06-24  |  3KB  |  115 lines
  1. {••• A simple Constraint solver: Uses a "Backtrack" algorithm •••}
  2. { To use it: simply open one of the example files in this folder 
  3.   and call the function (c) w/o any argument, answer questions }
  4.  
  5. {The main func: an environment, var list, domain list, constraint list}
  6.  
  7. (define (try env lv ld lc)
  8.  (cond (null? lv)'()
  9.        (let [(ne (maj env (0 lv) (0(0 ld))))]
  10.             (cond (tlc (0 lc) ne)
  11.                   (begin (printsol ne lv lc)
  12.                   (try ne (-1 lv) (-1 ld) (-1 lc))))
  13.             (cond (cons? (-1(0 ld)))
  14.                   (try env lv (cons (-1 (0 ld)) (-1 ld)) lc)))))
  15.  
  16. ;---- copy and upadte an env.
  17. (define (maj env var val)
  18.    (binding=! var (bcopy env) val))
  19.  
  20. ;---- check is all constraints are satisfied in the env
  21. (define (tlc lc env)
  22.   (cond (null? lc) †
  23.         (eval (0 lc) env) (tlc (-1 lc) env)))
  24.  
  25. ;---- prints the solution, if any
  26. (define (printsol env lv lc)
  27.    (cond (null? (-1 lv)) (begin (prinio "Solution:" stder)
  28.                                  (prinio env stder)
  29.                                  (prinio "
  30. " stder)
  31.                                  (flushio stder))))
  32.  
  33. ;---- I/F user
  34.  
  35. (define (c)
  36.   (let [(lv (begin (prin "Variables list: ")  (flushio stdo)(read)))
  37.         (lc (begin (prin "Constraints list:")(flushio stdo)(read)))
  38.         (ld (begin (prin "Domains list: ")   (flushio stdo)(read)))]
  39.        (try (apply makeenv lv) lv ld (créelvc lv (process lc lv) '()))))
  40.  
  41. ;---- seek o in s (deep search)
  42. (define (findall o s)
  43.    (cond (eq? o s) †
  44.          (not (cons? s)) ƒ
  45.          (findall o (0 s)) †
  46.          (findall o (-1 s))))
  47.  
  48. ;---- extract  variables constrained by the constraints   
  49. ;---- returns a list of conses (lv | cont)   
  50. (define (process lc lv)
  51.    (cond (null? lc) ()
  52.          (cons (cons (extract (0 lc) lv '()) (0 lc))
  53.                      (process (-1 lc) lv))))
  54.  
  55. (define (extract c lv bag)
  56.    (cond (null? lv) bag
  57.          (findall (0 lv) c) (extract c (-1 lv) (cons (0 lv) bag))
  58.          (extract c (-1 lv) bag)))
  59.  
  60. ;---- is in
  61. (define (isinq el l)
  62.   (cond (null? l) ƒ
  63.         (eq? el (0 l)) †
  64.         (isinq el (-1 l))))
  65.  
  66.  
  67. ;---- is included
  68. (define (isincluded e1 e2)
  69.    (cond (null? e1) †
  70.          (isinq (0 e1) e2) (isincluded (-1 e1) e2)))
  71.  
  72. ;---- built the list var constraints
  73. (define (créelvc lv lc b0)
  74.    (cond (null? lv) '()
  75.          (let [(x (trclv (0 lv) lc (cons (0 lv) b0) '() '()))]
  76.               (cons (-1 x)
  77.                     (créelvc (-1 lv) (0 x) (cons (0 lv) b0))))))
  78.  
  79.  (define (trclv v nlc e b1 b2)
  80.         (cond (null? nlc) (cons b2 b1)
  81.               (isincluded (0(0 nlc)) e) (trclv v (-1 nlc) e (cons (-1(0 nlc)) b1) b2)
  82.               (trclv v (-1 nlc) e  b1 (cons (0 nlc) b2))))
  83.  
  84. ;---- application of a binary op. to each couple in lv
  85. (define (genbin sym lv)
  86.   (cond (null? lv) ()
  87.         (append (mapcar1 (lambda(x) (list sym (0 lv) x)) (-1 lv))
  88.                    (genbin (-1 lv)))))
  89.  
  90. (define (mapcar1 f l)
  91.      (cond (null? l)()
  92.            (cons (f (0 l))
  93.                        (mapcar1 f (-1 l)))))
  94.  
  95. ;---- Propositionnal Logic
  96.  
  97. (define (ou a b)
  98.   (cond (=? a 0) b 1))
  99.  
  100. (define (non a)
  101.   (cond (=? a 0) 1 0))
  102.  
  103. (define (et a b)
  104.   (cond (=? a 0) 0 b))
  105.  
  106. (define (implique a b)
  107.   (cond (=? a 0) 1 b))
  108.  
  109. (define (vrai? a)
  110.   (=? a 1))
  111.  
  112. (define (faux? a)
  113.    (=? a 0))
  114.  
  115.